Otherware/Otherware_1_SB_Development.iso/mac/misc/update/tpasc302.cpt/TCL Update/New ArtClass Files/CPaintPane.p

Text File | 1990-05-11 | 14.7 KB | 594 lines

{****************************************************}
{         CPaintPane.p}
{}
{        The PaintPane Class}
{}
{        A MacPaint-type pane which stores a bitmap image. The PaintPane has}
{        its own offscreen image and port. The "real" image is stored offscreen}
{        and CopyBits operations are performed to put the image on the screen.}
{        A single ScratchPad BitMap, the same size as the paint image, is used}
{        in order to have smooth drawing (no flashing). This one scratchpad is}
{        shared by all PaintPanes (i.e, multiple windows). To implement undo,}
{        another bitmap is created to store sufficient information to restore}
{        the state of a painting. Each PaintPane has its own undo buffer.}
{        With multiple windows, this means that the "Undo" command will undo}
{        the last action for the active window.}
{}
{        The drawing tools are pretty simple: geometric shapes, pencil, brush,}
{        text tool, and selection rectangle.}
{}
{        Geometric shapes are constrained to squares (or circles) if the}
{        shift key is held down.}
{}
{        SUPERCLASS = CBitMapPane}
{}
{        Copyright ⌐ 1989, Symantec Corporation.  All rights reserved.            }
{}
{****************************************************}

unit CPaintPane;

interface

    uses
        TCL, MoreTCL, ArtClassIntf;

    const
        DELETE_KEY = 8;                    { Character code                    }
        PAT_MARCH_ANTS = 300;        { Pattern for marching ants        }
        iCUT = 6;                            { Index of task name for Cut        }
        iCLEAR = 9;                        { Index of task name for Clear    }

implementation



{*** C O N S T R U C T I O N / D E S T R U C T I O N   M E T H O D S ***}



{****************************************************}
{ IPaintPane}
{}
{        Initialize a PaintPane object}
{}
{****************************************************}

    procedure CPaintPane.IPaintPane (anEnclosure: CView; aSupervisor: CBureaucrat; aWidth, aHeight, aHEncl, aVEncl: integer; aHSizing, aVSizing: SizingOption; aBounds: Rect; aBitMap: CBitMap);
    begin
        IBitMapPane(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing, aBounds, aBitMap, TRUE);

        wantsClicks := TRUE;
        SetRect(selRect, 0, 0, 0, 0);
        lastTask := nil;
    end;


{****************************************************}
{ DoCommand (OVERRIDE)}
{}
{        Handle Edit commands}
{}
{****************************************************}

    procedure CPaintPane.DoCommand (theCommand: longint);
    begin
        if HiWord(-theCommand) = MENUtools then
            begin
                KillSelRect;
                inherited DoCommand(theCommand);
            end

        else
            begin
                case theCommand of

                    cmdCut:
                        begin
                            DoCopy;
                            DoClear(iCUT);
                        end;

                    cmdCopy:
                        DoCopy;

                    cmdPaste:
                        DoPaste;

                    cmdClear:
                        DoClear(iCLEAR);

                    otherwise
                        inherited DoCommand(theCommand);
                end;
            end;
    end;


{****************************************************}
{ UpdateMenus (OVERRIDE)}
{}
{        Enable appropriate Edit commands}
{}
{****************************************************}

    procedure CPaintPane.UpdateMenus;
    begin
        inherited UpdateMenus;

        if gGopher = SELF then
            begin
                if not EmptyRect(selRect) then
                    begin
                        gBartender.EnableCmd(cmdCut);
                        gBartender.EnableCmd(cmdCopy);
                        gBartender.EnableCmd(cmdClear);
                    end;

                if gClipboard.DataSize('PICT') > 0 then
                    gBartender.EnableCmd(cmdPaste);
            end;
    end;


{****************************************************}
{ DoClick (OVERRIDE)}
{}
{        Mouse click inside the PaintPane}
{}
{****************************************************}

    procedure CPaintPane.DoClick (hitPt: Point; modifierKeys: integer; when: longint);
        var
            thePaintTask: CPaintTask;
            theBounds: Rect;
            select: Boolean;
            notifiable: Boolean;
            theLastTask: CPaintTask;        { Altered by TCL Weaver 1.0 (5/9/90) }

    begin
        select := FALSE;
        notifiable := TRUE;
        if not PtInRect(hitPt, bounds) then
            Exit(DoClick);

        if gPaintTool <> toolSELECT then     { Any new painting will clobber the    }
            KillSelRect;                            {   selection                            }

        case gPaintTool of

            toolSELECT:                    { We could be selecting or dragging    }
                begin
                    notifiable := FALSE;
                    if PtInRect(hitPt, selRect) then
                        begin
                                    { Dragging the current selection        }

                            if (lastTask = nil) or not member(lastTask, CDragger) then
                                begin
                                    { This is a brand new drag, NOT the    }
                                    {   continuation of a previous one    }

                                    new(CDragger(theLastTask));     { Altered by TCL Weaver 1.0 (5/9/90) }
                                    lastTask := theLastTask;
                                    CDragger(lastTask).IDragger(SELF, itsBitMap);
                                    notifiable := TRUE;
                                end;
                            thePaintTask := lastTask;
                        end

                    else
                        begin                    { Make a selection rectangle            }
                            select := TRUE;
                            KillSelRect;
                            new(CSelectionRect(thePaintTask));
                            CSelectionRect(thePaintTask).ISelectionRect(SELF, itsBitMap);

                            gSleepTime := 0;        { Cursor shape needs to change within    }
                                        {   selection, so we must force an        }
                                        {   idle so that the mouse region will    }
                                        {   be updated                                }
                        end;
                end;

            toolBRUSH:
                begin
                    new(CToolBrush(thePaintTask));
                    CToolBrush(thePaintTask).IToolBrush(SELF, itsBitMap);
                end;

            toolPENCIL:
                begin
                    new(CToolPencil(thePaintTask));
                    CToolPencil(thePaintTask).IToolPencil(SELF, itsBitMap);
                end;

            toolERASER:
                begin
                    new(CToolEraser(thePaintTask));
                    CToolEraser(thePaintTask).IToolEraser(SELF, itsBitMap);
                end;

            toolRECT:
                begin
                    new(CToolRect(thePaintTask));
                    CToolRect(thePaintTask).IToolShapes(SELF, itsBitMap);
                end;

            toolFILLRECT:
                begin
                    new(CToolFillRect(thePaintTask));
                    CToolFillRect(thePaintTask).IToolShapes(SELF, itsBitMap);
                end;

            toolTEXT:
                begin
                    new(CToolText(thePaintTask));
                    CToolText(thePaintTask).IToolText(SELF, itsBitMap);
                end;

            toolRRECT:
                begin
                    new(CToolRRect(thePaintTask));
                    CToolRRect(thePaintTask).IToolShapes(SELF, itsBitMap);
                end;

            toolFILLRRECT:
                begin
                    new(CToolFillRRect(thePaintTask));
                    CToolFillRRect(thePaintTask).IToolShapes(SELF, itsBitMap);
                end;

            toolLINE:
                begin
                    new(CToolLine(thePaintTask));
                    CToolLine(thePaintTask).IToolShapes(SELF, itsBitMap);
                end;

            toolOVAL:
                begin
                    new(CToolOval(thePaintTask));
                    CToolOval(thePaintTask).IToolShapes(SELF, itsBitMap);
                end;

            toolFILLOVAL:
                begin
                    new(CToolFillOval(thePaintTask));
                    CToolFillOval(thePaintTask).IToolShapes(SELF, itsBitMap);
                end;

            otherwise
                ;
        end;

        theBounds := bounds;            { Mouse down drawing within the    }
                                    {   bounds of the painting                }

        TrackMouse(thePaintTask, hitPt, theBounds);

        if select then                 { Selection is not undoable so we    }
            thePaintTask.Free            {   don't need the task anymore        }
        else
            begin
                if notifiable then             { Make sure we don't re-notify in    }
                                        {   the case of a resumed drag        }

                    itsSupervisor.Notify(thePaintTask);

                lastTask := thePaintTask;    { Save task for later reference    }
            end;
    end;


{****************************************************}
{ AdjustCursor (OVERRIDE)}
{}
{        Adjust the shape of the cursor according the position of the mouse.}
{}
{****************************************************}

    procedure CPaintPane.AdjustCursor (where: Point; mouseRgn: RgnHandle);
        var
            mouseRect: Rect;

    begin
        WindToFrame(where);
        if not PtInRect(where, bounds) then
            begin
                SetCursor(arrow);                { Mouse is outside the drawing    }
                mouseRect := bounds;            {   area                            }
                FrameToGlobalR(mouseRect);
                RectRgn(gUtilRgn, mouseRect);
                DiffRgn(mouseRgn, gUtilRgn, mouseRgn);
                Exit(AdjustCursor);
            end;

        case gPaintTool of                { Cursor shape depends on tool        }

            toolSELECT:
                if PtInRect(where, selRect) then
                    SetCursor(gDragCurs^^)
                else
                    SetCursor(gSelectCurs^^);

            toolBRUSH:
                SetCursor(gBrushCurs^^);

            toolPENCIL:
                SetCursor(gPencilCurs^^);

            toolERASER:
                SetCursor(gEraserCurs^^);

            toolTEXT:
                SetCursor(gIBeamCursor^^);

            toolRECT, toolFILLRECT, toolRRECT, toolFILLRRECT, toolLINE, toolOVAL, toolFILLOVAL:
                SetCursor(gShapeCurs^^);

            otherwise
                ;
        end;

        if not EmptyRect(selRect) then
            begin                                { Cursor changes shape inside    }
                mouseRect := selRect;            {   selection rectangle            }
                FrameToGlobalR(mouseRect);
                RectRgn(gUtilRgn, mouseRect);
                if PtInRect(where, selRect) then
                    SectRgn(mouseRgn, gUtilRgn, mouseRgn)
                else
                    DiffRgn(mouseRgn, gUtilRgn, mouseRgn);
            end;

        mouseRect := bounds;                    { In case frame is bigger than    }
        FrameToGlobalR(mouseRect);            {   bounds                            }
        RectRgn(gUtilRgn, mouseRect);
        SectRgn(mouseRgn, gUtilRgn, mouseRgn);
    end;


{****************************************************}
{ DoKeyDown (OVERRIDE)}
{}
{        Hitting the backspace/delete key clears the current selection}
{}
{****************************************************}

    procedure CPaintPane.DoKeyDown (theChar: char; keyCode: Byte; macEvent: EventRecord);
    begin

        if (theChar = chr(DELETE_KEY)) and not EmptyRect(selRect) then
            DoClear(iCLEAR)

        else
            inherited DoKeyDown(theChar, keyCode, macEvent);

    end;


{****************************************************}
{ Dawdle (OVERRIDE)}
{}
{        Animate the selection rectangle during Idle time}
{}
{****************************************************}

    procedure CPaintPane.Dawdle (var maxSleep: longint);
        var
            thePat: Pattern;
            ticks: longint;
            sRect: Rect;

    begin
        if not EmptyRect(selRect) then
            begin                                { Make sure selection exists            }
                sRect := selRect;
                Prepare;

                PenNormal;                        { Draw rectangle with one pattern    }
                GetIndPattern(thePat, PAT_MARCH_ANTS, 1);
                PenPat(thePat);
                FrameRect(sRect);

                Delay(6, ticks);            { Wait a while                            }

                                    { Redraw with a pattern offset from    }
                                    {   the first. This gives the                }
                                    {   illusion of marching ants.                }

                GetIndPattern(thePat, PAT_MARCH_ANTS, 2);
                PenPat(thePat);
                FrameRect(sRect);
                maxSleep := 5;
            end;
    end;


{****************************************************}
{ ChangeSize}
{}
{        Change the size of a PaintPane. If necessary, shift painting so}
{        that it always completely covers the frame.}
{}
{****************************************************}

    procedure CPaintPane.ChangeSize (delta: Rect; redraw: Boolean);
        var
            hShift, vShift: integer;

    begin
                                        { If new size would cause the        }
                                        {   frame to extend beyond the    }
                                        {   bounds of the painting, we        }
                                        {   have to shift the painting.        }

        hShift := Max(frame.right + delta.right - bounds.right, 0);
        vShift := Max(frame.bottom + delta.bottom - bounds.bottom, 0);

        inherited ChangeSize(delta, redraw);

        if (hShift > 0) or (vShift > 0) then
            begin
                Scroll(-hShift, -vShift, false);
                if redraw then
                    Refresh;
            end;
    end;


{****************************************************}
{ KillSelRect}
{}
{        Get rid of selection rectangle and finalize the last task}
{}
{****************************************************}

    procedure CPaintPane.KillSelRect;
        var
            sRect: Rect;

    begin
        if lastTask <> nil then
            begin                        { Killing selection means we are about    }
                lastTask.DoTask;            {   to do something new. Let the last    }
                lastTask := nil;            {   task finalize its actions.                }
            end;
        sRect := selRect;                    { Set empty selection and force redraw    }
        SetRect(selRect, 0, 0, 0, 0);    {   of old selection to clear out the            }
        DrawAll(sRect);                    {   marching ants                                }
    end;


{****************************************************}
{ Deactivate (OVERRIDE)}
{}
{        Kill selection when deactivated}
{}
{****************************************************}

    procedure CPaintPane.Deactivate;
    begin
        inherited Deactivate;

        if ReallyVisible then     { Don't bother to kill selection if    }
            KillSelRect;                {   Pane is not visible                    }
    end;


{****************************************************}
{ DoCopy}
{}
{        Copy selection to the clipboard. This action is NOT undoable.}
{}
{****************************************************}

    procedure CPaintPane.DoCopy;
        var
            thePic: PicHandle;
            theSelRect: Rect;

    begin
        itsBitMap.BeginDrawing;
        theSelRect := selRect;
                                    { Open picture to store selection    }

        thePic := OpenPicture(theSelRect);

                                    { Draw selection on top of itself    }

        itsBitMap.CopyFrom(theSelRect, theSelRect, nil);
        ClosePicture;
        itsBitMap.EndDrawing;

                                    { Copy picture to the clipboard    }

        gClipboard.PutData('PICT', Handle(thePic));
        KillPicture(thePic);
    end;


{****************************************************}
{ DoPaste}
{}
{        Paste picture from the clipboard. This action isn't truly}
{        undoable. We fool the pane into thinking that a drag has}
{        occurred.}
{}
{****************************************************}

    procedure CPaintPane.DoPaste;
        var
            thePic: PicHandle;
            anyPt: Point;
            pFrame: Rect;
            theLastTask: CPaintTask;        { Altered by TCL Weaver 1.0 (5/9/90) }

    begin
        if gClipboard.GetData('PICT', Handle(thePic)) then
            begin
                                        { Set tool to selection rectangle        }
                                        {   so pasted image can be dragged    }

                DoCommand(-(BSL(MENUtools, 16) + integer(toolSELECT)));

                                        { Paste is treated as a drag in    }
                                        {   progress                        }

                new(CDragger(theLastTask));     { Altered by TCL Weaver 1.0 (5/9/90) }
                lastTask := theLastTask;
                CDragger(lastTask).IDragger(SELF, itsBitMap);

                                            { Place pasted picture near the    }
                                            {   top left of the pane            }
                selRect := thePic^^.picFrame;
                OffsetRect(selRect, frame.left + 36 - selRect.left, frame.top + 36 - selRect.top);

                                            { Save bits under the paste        }

                pFrame := selRect;
                CopyBits(itsBitMap.macBitMap, gScratchPad.macBitMap, pFrame, pFrame, srcCopy, nil);

                itsBitMap.BeginDrawing;            { Draw pasted image on painting    }
                DrawPicture(thePic, pFrame);
                itsBitMap.EndDrawing;

                anyPt := topLeft(pFrame);        { Fake out Dragger into thinking    }
                                            {   a selection has been dragged    }
                lastTask.BeginTracking(anyPt);

                CopyBits(gScratchPad.macBitMap, itsBitMap.macBitMap, pFrame, pFrame, srcCopy, nil);

                lastTask.EndTracking(anyPt, anyPt, anyPt);

                RefreshRect(pFrame);            { Force redraw and proceed as    }
                gSleepTime := 0;                    {   a suspended drag                }
                itsSupervisor.Notify(lastTask);
                KillPicture(thePic);
            end;
    end;


{****************************************************}
{ DoClear}
{}
{        Erase the current selection}
{}
{****************************************************}

    procedure CPaintPane.DoClear (taskIndex: integer);
        var
            theClear: CClearTask;

    begin                                { Can't get much simpler:        }
                                        {   Create a task, do it, and tell    }
                                        {   supervisor it's been done        }
        new(theClear);
        theClear.IClearTask(taskIndex, SELF, itsBitMap);
        theClear.DoTask;
        itsSupervisor.Notify(theClear);
        lastTask := theClear;
    end;


end.